home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_paint < prev    next >
Encoding:
Text File  |  1991-12-30  |  1.6 KB  |  74 lines
  1. \ Demonstrate simple graphics editing based on event driven input.
  2. \ Clear screen if double click detected.
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1986  Delta Research
  6. \
  7. \ MOD: PLB 8/6/88 Add double click detection.
  8.  
  9. include? newwindow.setup ju:amiga_graph
  10. include? ev.getclass ju:amiga_events
  11.  
  12. ANEW TASK-DEMO_PAINT
  13.  
  14. NewWindow PaintWindow   ( Create a template for the new window. )
  15.  
  16. : CYCLE.COLORS ( -- , change to next color )
  17.     gr.color@ 1+ 3 and dup 0=
  18.     IF drop 1 THEN   gr.color!
  19. ;
  20.  
  21. USER IF-DOWN  ( Keep track of whether mouse button is down. )
  22.  
  23. : PROCESS.EVENT ( class -- done? , process events from IDCMP )
  24.     CASE
  25.         MOUSEBUTTONS OF   ( check for up or down )
  26.             ev-last-code @ SELECTDOWN =
  27.             IF  true if-down !
  28.                 ev.getxy00 gr.move  ( MOVE graphics pen to down x,y )
  29.                 ev.2click?    ( clear on double click )
  30.                 IF gr.clear
  31.                 THEN
  32.             ELSE false if-down !
  33.             THEN false
  34.         ENDOF
  35.  
  36.         MOUSEMOVE OF if-down @
  37.             IF  ev.getxy00 gr.draw  cycle.colors
  38.             THEN  false
  39.         ENDOF  ( DRAW )
  40.  
  41.         CLOSEWINDOW OF true ENDOF
  42.  
  43.         warning" PAINT.LOOP -- Unrecognized event!"
  44.         false swap
  45.     ENDCASE
  46. ;
  47.  
  48. : PAINT.LOOP  ( -- , loop until done )
  49.     BEGIN
  50.         gr-curwindow @ ev.wait
  51.         gr-curwindow @ ev.getclass dup
  52.         IF process.event
  53.         THEN
  54.     UNTIL
  55. ;
  56.  
  57. : PAINT  ( -- , Demonstrate painting. )
  58.     gr.init
  59.     PaintWindow NewWindow.Setup      ( Set defaults for window )
  60.     0" Paint - JForth - DoubleClick to Clear Window!"
  61.         >abs  PaintWindow ..! nw_title
  62.     CLOSEWINDOW MOUSEBUTTONS | MOUSEMOVE |   ( add MOUSEMOVE )
  63.     PaintWindow ..! nw_idcmpflags
  64. \
  65. \ Create window from template and make it the current window.
  66.     PaintWindow gr.opencurw
  67.     IF  PAINT.LOOP
  68.         gr.closecurw
  69.     THEN
  70.     gr.term
  71. ;
  72.  
  73. cr ." Enter:   PAINT     for demo!" cr
  74.